QRZ! Ham Radio 6/QRZ Ham Radio Callsign Database - Volume 6.iso/pc/files/f6fbb/cc920724.lzh/CC.PAS

Pascal/Delphi Source File | 1992-07-24 | 10.4 KB | 361 lines

program CC;

{ OH3NWQ                                                  }
{ written in turbo pascal 6.0                             }
{ tämähän on onneksi vain harrastus (vai olenko väärässä) }
{ ja harrastuksenhan voi lopettaa sillä hetkellä kun se   }
{ alkaa tuntua työltä ...                                 }
{                                                         }
{ I did this programme for my own use...                  }
{                                                         }
{ syntax:                                                 }
{          sp cc                                          }
{          The title for all the messages                 }
{          CC: oh3nwq @ oh3rbr.fin.eu                     }
{          CC: ua3lid @ ua3rk.rus.eu                      }
{          The text as you would type it when mailing     }
{          a normal mail...                               }
{          /EX                                            }
{                                                         }
{ new on 920715                                           }
{          /7 and /8 commands                             }
{          You can also use CC: /7 and CC: /8             }
{          and the scandinavian/german special characters }
{          will be translated to their 7 (or 8) bit       }
{          representatives.                               }
{          These commands will take effect on the         }
{          callsigns following the CC: /7 line.           }
{ new on 920721                                           }
{          Windows characters                             }
{ new on 920724                                           }
{          CC: /V verbose mode                            }
{          I.e. copy >CC: lines - default: no copy        }

uses DOS;

type
    pitkajono = string[80];
    lyhytjono = string[9];

var
    mista, mihin,
    missa, tiedot, ots, cc_kutsu       : pitkajono;
    kutsu, lah                         : lyhytjono;
    cc_found, skandi7ksi, skandi8ksi,
    verbose                            : boolean;
    numero                             : integer;

const
    copyright = 'Carbon Copy for FBB 5.14 v.1992-07-24 by OH3NWQ @ OH3RBR.FIN.EU';


function alkunolla(sana : word) : lyhytjono;
var
   jono : lyhytjono;

begin
     str(sana:0,jono);
     if length(jono) = 1 then
        jono := '0' + jono;
     alkunolla := jono;
end;


function muunna7(muunnettava : pitkajono) : pitkajono;

var
   laskuri : integer;
   merkki  : char;
   apujono : pitkajono;

begin
     apujono := '';
     for laskuri := 1 to length(muunnettava) do
     begin
          merkki := muunnettava[laskuri];
          case merkki of
                         {Finnish}
                         'ä' : merkki := '{';
                         'ö' : merkki := '|';
                         'å' : merkki := '}';
                         'Ä' : merkki := '[';
                         'Ö' : merkki := '\';
                         'Å' : merkki := ']';

                         {Danish}
                         'æ' : merkki := '{';
                         'Æ' : merkki := '[';
                         '¢' : merkki := '|';
                         '¥' : merkki := '\';

                         {German}
                         'ü' : merkki := '~';
                         'Ü' : merkki := '^';
                         'ß' : merkki := '}';

                         {Windows}
                         'Σ' : merkki := '{';
                         '÷' : merkki := '|';
                         'σ' : merkki := '}';
                         '─' : merkki := '[';
                         '╓' : merkki := '\';
                         '┼' : merkki := ']';

                      end;
          if (ord(merkki) > 127) then merkki := '*';
          apujono := apujono + merkki;
     end;
     muunna7 := apujono;
end;


function muunna8(muunnettava : pitkajono) : pitkajono;

var
   laskuri : integer;
   merkki  : char;
   apujono : pitkajono;

begin
     apujono := '';
     for laskuri := 1 to length(muunnettava) do
     begin
          merkki := muunnettava[laskuri];
          case merkki of '{' : merkki := 'ä';
                         '|' : merkki := 'ö';
                         '}' : merkki := 'å';
                         '[' : merkki := 'Ä';
                         '\' : merkki := 'Ö';
                         ']' : merkki := 'Å';
                         end;
          apujono := apujono + merkki;
     end;
     muunna8 := apujono;
end;



procedure hae_osoite(hmista : pitkajono ; var lah : lyhytjono ;
                     var otsikko : pitkajono);

var
   sisaan                           : text;
   ekarivi, tokarivi, apu           : pitkajono;
   paikka, pituus, k, kir, nro, pis : integer;
   merkki                           : char;

begin
     assign(sisaan,hmista);
     reset (sisaan);

     readln(sisaan,ekarivi);
     readln(sisaan,otsikko);

     close (sisaan);

     lah       := '';
     paikka    := pos('<',ekarivi);
     pituus    := length(ekarivi);

        for k := paikka+1 to pituus do
            begin
               if copy(ekarivi,k,1) > ' ' then
                  lah := lah+copy(ekarivi,k,1);
            end;

     if ((length(lah) > 6) or (length(lah) < 4)) then halt(0);

end;


procedure aloita_vastaus(lahettaja,otsikko,kelle,imprtfile,polku : pitkajono);

const
     days : array [0..6] of lyhytjono  =
                  ('Sunday','Monday','Tuesday','Wednesday',
                   'Thursday','Friday','Saturday');

var
     ulos               : text;
     ho, mi, se, hund,
     ye, mo, da, dow    : word;

begin

     if fsearch(imprtfile,polku) = '' then
        begin
           assign(ulos,polku+imprtfile);
           rewrite(ulos);
           close(ulos);
        end;

     assign(ulos,polku+imprtfile);
     append(ulos);

     writeln(ulos,'SP ',kelle,' <',lahettaja);
     writeln(ulos,otsikko);
     writeln(ulos);
     writeln(ulos,copyright);
     gettime(ho,mi,se,hund);
     getdate(ye,mo,da,dow);
     writeln(ulos,'CC sent at ', days[dow],', ',
             ye:0, '-', alkunolla(mo), '-', alkunolla(da),'  ',
             alkunolla(ho),':',alkunolla(mi), ':',alkunolla(se),
             '.',alkunolla(hund));
     writeln(ulos);
     close(ulos);
end;


procedure kopioi_rivit(mikatied,imprtfile,polku : pitkajono;
                       s7,s8,verbose : boolean);

var
     sisaan, ulos : text;
     rivi         : pitkajono;
     nro          : word;

begin
     nro := 0;
     assign(ulos,polku+imprtfile);
     append(ulos);

     assign(sisaan,mikatied);
     reset (sisaan);

     repeat
           begin
                 readln  (sisaan,rivi);
                 nro := nro+1;
                 if not (copy(rivi,1,3) = '/EX') then
                 begin
                      if ((copy(rivi,1,3) = 'CC:') or (nro < 3)) then
                      begin
                           if verbose then
                           begin
                                rivi := copy(rivi,1,79);
                                writeln (ulos,'>',rivi);
                           end;
                      end else
                      begin
                           rivi := copy(rivi,1,80);
                           if s7 then rivi := muunna7(rivi);
                           if s8 then rivi := muunna8(rivi);
                           writeln (ulos,rivi);
                      end;
                 end;
           end;
     until (eof(sisaan)) or (copy(rivi,1,3) = '/EX');

     writeln(ulos,'/EX');

     close  (ulos);
     close  (sisaan);
end;


procedure find_cc(mikatied : pitkajono ; var numero   : integer ;
                  var cc_kutsu : pitkajono ; var  cc_found,
                  s7, s8, verbose : boolean );
var
     jono   : pitkajono;
     inte   : integer;
     sisaan : text;

begin
     assign(sisaan,mikatied);
     reset (sisaan);

     for inte := 1 to numero do readln(sisaan,jono);

     readln(sisaan,jono);
     close (sisaan);

     numero := numero+1;

     if not (copy(jono,1,3) = 'CC:') then
        begin
             cc_found := false;
             exit;
        end;

     if (pos('/8',jono) > 0) then
        begin
             cc_found := true;
             cc_kutsu := 'CC';
             s7       := false;
             s8       := true;
             exit;
        end;

     if (pos('/7',jono) > 0) then
        begin
             cc_found := true;
             cc_kutsu := 'CC';
             s7       := true;
             s8       := false;
             exit;
        end;

     if ((pos('/v',jono) > 0) or (pos('/V',jono) > 0))then
        begin
             cc_found := true;
             cc_kutsu := 'CC';
             verbose  := true;
             exit;
        end;

     if pos(',',jono) > 0 then
        begin
             cc_found := false;  {invalid syntax}
             exit;
        end;

     if pos('<',jono) > 0 then
        begin
             cc_found := false;  {lähettäjän asematunnuksen vaihto}
             exit;
        end;

     cc_kutsu := copy(jono,4,length(jono)-3);

end;


begin   {Pääohjelma}

     lah         := '';
     mista       := paramstr(1);
     cc_found    := true;
     skandi7ksi  := false;
     skandi8ksi  := false;
     verbose     := false;
     mihin       := 'MAIL.IN';
     missa       := 'C:\FBB\';
     numero      := 2;           { SP CC < OH3NWQ and TITLE }

     if paramcount < 1 then
        begin
             writeln;
             writeln(copyright);
             writeln('CC is a server to be called from a FBB 5.14 mailbox.');
             writeln;
             writeln('You can also use it from dos : CC filename.ext');
             writeln;
             writeln('The input file must be a FBB export file');
             writeln('Output goes to the FBB import file ', missa, mihin);
             halt(0);
        end;


     hae_osoite(mista,lah,ots);

     repeat
          find_cc(mista,numero,cc_kutsu,cc_found,skandi7ksi,skandi8ksi,verbose);
          if ((cc_found) and (cc_kutsu <> 'CC')) then
          begin
               aloita_vastaus(lah,ots,cc_kutsu,mihin,missa);
               kopioi_rivit(mista,mihin,missa,skandi7ksi,skandi8ksi,verbose);
          end;
     until not cc_found;
end.